﻿namespace Lilium.LParse

type Parser<'s, 'a> = Parser of (list<'s> -> ('a * list<'s>) list)

module Parser =
    
    open System

    open Prelude

    let unParser (Parser p) = p

    let success a = 
        Parser (fun input -> [(a, input)])

    let fail =
        Parser (fun _ -> [])

    let satisfy p = 
        Parser (fun (input : 's list) -> match input with
                                         | (s::ss) when p s -> [(s,ss)]
                                         | _ -> [])

    // category

    let compose (Parser p1) (Parser p2) = 
        Parser (fun input -> [ for (v1, ss1) in p1 input do 
                               for (v2, ss2) in p2 ss1 -> (v1 v2, ss2) ])

    // functor

    let apply f p =
        compose (success f) p

    // alternative

    let choise (Parser p1) (Parser p2) = 
        Parser (fun input -> p1 input @ p2 input)

    // monad

    let bind (Parser p) selector = 
        Parser (fun input -> [ for (v1, ss1) in p input do
                               for res in unParser (selector v1) ss1 -> res ])